home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtaesmen.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  5.0 KB  |  136 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtAESMenus;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  1.00     | 09.02.92 |  Hp  |                                        *
  28.  *-----------+----------+------+----------------------------------------*)
  29.  
  30.  
  31.  
  32. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  33. (*                                              *)
  34. (*$R-   Range-Checks                            *)
  35. (*$S-   Stack-Check                             *)
  36. (*                                              *)
  37. (*----------------------------------------------*)
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  45.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  46.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  47.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  48.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  49.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  50.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  51.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58. FROM SYSTEM     IMPORT  ADDRESS, ADR, TSIZE;
  59. FROM MagicAES   IMPORT  LASTOB, DISABLED, OBJECT, PtrPARMBLK;
  60. FROM mtAppl     IMPORT  PrivateWS, MouseOn, MouseOff, MouseArrow,
  61.                         CharWidth, CharHeight, BoxWidth, BoxHeight, 
  62.                         InstallTermproc;
  63. FROM mtUtils    IMPORT  tRect, tObjcTree, ScanFlags, SearchType, ObjcString;
  64. IMPORT  MagicAES, MagicVDI, mtXobjects;
  65.  
  66. VAR menuline: ADDRESS;
  67.  
  68.  
  69. PROCEDURE DrawLine (p: PtrPARMBLK): BITSET;
  70. (* Zeichnet eine Linie *)
  71. VAR i: INTEGER;
  72. BEGIN
  73.  i:= MagicVDI.SetFillcolor (PrivateWS, 1);
  74.  i:= MagicVDI.SetFillstyle (PrivateWS, 4);
  75.  i:= MagicVDI.SetFillinterior (PrivateWS, 2);
  76.  MagicVDI.VDIPtsIn[0]:= p^.pbX;
  77.  MagicVDI.VDIPtsIn[1]:= p^.pbY + (CharHeight DIV 2) - 1;
  78.  MagicVDI.VDIPtsIn[2]:= p^.pbX + p^.pbW - 1;
  79.  MagicVDI.VDIPtsIn[3]:= p^.pbY + (CharHeight DIV 2);
  80.  MagicVDI.VDICall(11, 2, 0, 1, PrivateWS);
  81.  i:= MagicVDI.SetFillinterior (PrivateWS, 1);
  82.  i:= MagicVDI.SetFillstyle (PrivateWS, 0);
  83.  i:= MagicVDI.SetFillcolor (PrivateWS, 0);
  84.  RETURN {};
  85. END DrawLine;
  86.  
  87.  
  88. PROCEDURE InitMenuline (menu: ADDRESS): BOOLEAN;
  89. VAR line: tObjcTree;
  90.     str:  ARRAY [0..80] OF CHAR;
  91.     i:    sINTEGER;
  92.     b:    BOOLEAN;
  93. BEGIN
  94.  
  95.  (* Baum scannen und Extended Objects installieren *)
  96.  i:= 0;  line:= menu;
  97.  LOOP
  98.   str[0]:= 0C;  str[1]:= 0C;  str[2]:= 0C;
  99.   IF DISABLED IN line^[i].obState THEN
  100.    ObjcString (line, i, str);
  101.    IF (str[0] = '-') AND (str[1] = '-') AND (str[2] = '-') THEN
  102.     (* Dat mžte eine '-----'-Zeile sein, denn 'normale' Eintr„ge sollten
  103.      * in den ersten Zeichen Blanks haben
  104.      *)
  105.     IF NOT mtXobjects.InstUserdef (line, i, DrawLine, NIL) THEN
  106.      RETURN FALSE;
  107.     END; (* IF NOT *)
  108.    END; (* IF str *)
  109.   ELSIF LASTOB IN line^[i].obFlags THEN (* Fertisch!! *)
  110.    EXIT;
  111.   END; (* IF DISABLED *)
  112.   INC (i);
  113.  END; (* LOOP *)
  114.  
  115.  RETURN TRUE;
  116. END InitMenuline;
  117.  
  118. PROCEDURE DrawMenuline (menu: ADDRESS);
  119.   VAR i : INTEGER;
  120. BEGIN
  121.  menuline:= menu;
  122.  i := MagicAES.MenuBar (menu, 1);
  123. END DrawMenuline;
  124.  
  125. PROCEDURE ResetMenuline;
  126.   VAR i : INTEGER;
  127. BEGIN
  128.  i := MagicAES.MenuBar (menuline, 0);
  129. END ResetMenuline;
  130.  
  131. BEGIN
  132.  menuline:= NIL;
  133.  InstallTermproc (ResetMenuline);
  134. END mtAESMenus.
  135.  
  136.